perm filename RHYTH.F4[NEW,LCS]27 blob
sn#496799 filedate 1980-02-09 generic text, type T, neo UTF8
00100 C***** SUBRS RHYTH, NOTNUM, DOTS ********
00200
00300 SUBROUTINE RHYTH
00400 COMMON/RINP/R(10,85),POSNT(0/99)
00500 1 /RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,PS2,
00600 1 RA,RDD,ITB,POSB /PTR/KWDS(1) /FRMT/FQZ(3)
00700 1 /XRN/RN(1) /IDEV/IDEV
00800 1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00900 1 /SCX/JALPHA(30),JX,JXX,JZ,IRHY,JD,KA,KB,IZ
01000 1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,
01100 1 NFLG,KXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
01200 1 /ALF/INP(59),NX,NOTE,JSET,KZ,KX,AVGPOS,RLPOS,RLP2,
01300 1 AVP2,ZX,RE,ZZ,RD,RSTX
01400 C SEE ALSO FILLMS, SETLET AND SETUP RE. /FLM/
01500 DIMENSION RPOS(2,100)
01600 COMMON R2,JH,CENTR,J2,R3,R4,R5,RJQ(17),J3,JQ(19)
01700 1 /DPY/ST(4000),MEDIT,GO /LIMIT/LIMIT,ITEM,NL,NO,NONO
01800 1 /POS/POS1,POS2 /STF/RSTFAC(0/7),RSTJ2
01900 EQUIVALENCE (VX(1),X),(VX(2),Y),(VX(7),Z),(RPOS,ST(3400))
02000 1,(VX(3),AB),(VX(4),T),(VX(5),RB),(VX(6),X2)
02100 1,(VX(8),C),(VX(9),S),(VX(10),X3)
02200
02300 CCC DATA FIB/.75/
02400 C FIB IS FOR PSUEDO-FIBONACCI SPACING
02500 RSTJ3=RSTFAC(IFIX(STAFF))
02600 POSNT(0)=-1
02700 POSNT(1)=-1
02800 C IN CASE 1ST NOTE IS AT POS. ZERO
02900 NX=-1
03000 JX=0
03100 T=0
03200 Y=0
03300 NOTE=0
03400 ICNTPT=-1
03500 NOSET=0
03600 JSET=0
03700 C STUP IS NEG. IF SETUP IS NOT READY
03800 IF(STUP)GO TO 341
03900 IF(SET4.NE.STAFF)GO TO 70
04000 NOSET=-1
04100 C TO ADD MORE NOTES ON SETUP LINE. WIPES OUT P9 AT END OF SCMSS.
04200 GO TO 270
04300 70 DO 370 K=1,ITEM-1
04400 CXX******** 1/80 70 DO 370 K=1,ITEM-IZ-1
04500 C LOOKS ONLY AT THINGS BEFORE CURRENT INPUT.
04600 J=KWDS(K)
04700 IF(RN(J+1).GT.2)GO TO 370
04800 IF(RN(J+2).EQ.STAFF)GO TO 270
04900 370 CONTINUE
05000 GO TO 170
05100 270 ICNTPT=0
05200 C THIS WILL CAUSE NOTES ADDED TO LINE TO HAVE NO RHYTH VAL IN P9
05300 170 KZ=1
05400 POS2=PS2
05500 C GETS LAST ↑↑ POS. FROM SETUP
05600 JSET=-1
05700 C NEXT NUM.(100) IS LIMIT FOR STF.4 (CAN BE UP TO 300-SEE /FLM/)
05800 DO 9 KX=1,100
05900 9 IF(RPOS(2,KX).GE.0)GO TO 10
06000 10 AVGPOS=RPOS(1,KX)
06100 RLPOS=AVGPOS
06200 344 KX=KX+1
06300 IF(RPOS(2,KX).EQ.-3)GO TO 344
06400 C**** IGNORES CLEFS (BUT NOT BARS) IN AUTOMATIC SPACING ***** 10/76
06500 RLP2=RPOS(1,KX)
06600 343 AVP2=RPOS(2,KX)-.001
06700 IF(AVP2.GT.0)GO TO 341
06800 KX=KX+1
06900 GO TO 343
07000 C AVERAGED AND REAL POSITIONS FROM 'SETUP'
07100
07200 C NEXT FOR NON-SETUP
07300 341 DO 34 K=1,IRHY
07400 CALL DOTS(VAL,RH,K,DOT)
07500 C VAL=RHYTH. VALUE (QTR=1), RH=DENOMINATOR (QTR=4), DOT=NUM OF DOTS
07600 C 88TH NOTES ARE TAKEN AS GRACE NOTES. THEN BECOME 32NDS.
07700 IF(RH.NE.88)GO TO 345
07800 IF(JSET)GO TO 34
07900 C GRACE NOTES SKIPPED IN AUTOMATIC SETUP
08000 VAL=.1
08100 CFIB345 IF(STUP.LT.-1)VAL=PFIBX(VAL)
08200 345 IF(STUP.LT.-1)VAL=14.0*EXP(ALOG(VAL)*0.5849624)
08300 C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5)) NOT FIBBONACI (1.618)
08400 CCC345 IF(STUP.LT.-1)Z=Z+(.125-Z)*FIB
08500 C STUP CAN BE SET TO .LT.-1 IN NOTBMS FOR PSUEDO-FIBONACCI SPACE
08600 Y=Y+VAL
08700 34 CONTINUE
08800 C Y=TOTAL TIME
08900 C A SAFEGUARD
09000 C SAVES POS1 FOR POSITIONING MF, CRESC. ETC.
09100 NTC=0
09200 C THE WORD COUNT FOR REAL NOTES.
09300 IF(JSET)GO TO 3421
09400
09500 IF(POS1.LT.POS2)POSX=POS1
09600 C SAVES IT FOR BACKUP
09700 IF(POS1.GE.POS2)POS1=POSX
09800
09900 Z=POS2-POS1
10000 ZX=Z
10100 342 DO 1 K=1,IZ
10200 X=R(1,K)
10300 IF(X.LT.3.)GO TO 1
10400 C JUMP IF NOTE OR REST
10500 IF(X.NE.17.)GO TO 8
10600 C JUMP IF NOT A KEY SIG.
10700 RA=AMOD(R(5,K),100.0)
10800 C 100+KEY SIG NUM = SIG MADE UP OF NATURALS.
10900 RA=2.+ABS(RA)*2.0
11000 IF(K.GT.1)R(8,K-1)=R(8,K-1)+RSTJ3
11100 C PUSH KSIG 1*SIZE TO RIGHT OF PREVIOUS ITEM.
11200 GO TO 6
11300 8 IF(X.NE.4.)GO TO 81
11400 C NEXT IS FOR BAR LINES
11500 RA=3
11600 J=K+1
11700 RE=R(1,J)
11800 IF(RE.EQ.3.)RA=1.5
11900 C A CLEF
12000 IF(RE.EQ.18)RA=2.5
12100 C A METER
12200 IF(RE.NE.1)GO TO 83
12300 IF(AMOD(R(5,J),10.).NE.0)RA=4.5
12400 C FINDS ACCI ON NEXT NOTE.
12500 83 IF(K.EQ.IZ)RA=0
12600 C END OF STAFF
12700 GO TO 6
12800 82 RA=5
12900 CGHB82 RA=6
13000 GO TO 83
13100 81 IF(X.EQ.18)GO TO 82
13200 RA=6.
13300 IF(K.LT.3)RA=8.
13400 CGHB RA=7.
13500 C FOR CLEFS
13600 CGHB IF(K.LT.3)RA=9.
13700 C THE FIRST CLEF IS NOT MINI
13800 6 RA=RA*RSTJ3
13900 C SO SPACE WILL DEPEND ON SIZE OF STAFF
14000 Z=Z-RA
14100 R(8,K)=RA
14200 C STORES SPACE NUM THAT MUST BE GIVEN BACK
14300 1 CONTINUE
14400 C SUBTRACTS SPACE FOR CLEF OR BAR. WILL ADD BOTH LATER.
14500 C POS1 AND Z ARE FOR RHYTHMIC SPACING
14600 C SPACE FOR NON-NOTES
14700 3421 K=0
14800 IF(ABS(Y-RA).LE..001)GO TO 3
14900 IF(JSET)CALL MISMCH(RA,Y)
15000 C TYPES MISMATCH MESSAGE
15100
15200 C LOOP TO END
15300 3 K=K+1
15400 C K IS COUNTER
15500 T=0
15600 CXX R(7,K)=0
15700 RE=R(1,K)
15800 IF(RE.LE.2.)GO TO 2
15900 RD=R(8,K)
16000 R(8,K)=0
16100 IF(JSET)GO TO 71
16200
16300 7 IF(K.EQ.IZ)POS1=POS2
16400 IF(R(1,K-1).GT.2.)GO TO 73
16500 IF(K.EQ.1)GO TO 73
16600 IF(RE.EQ.4.)GO TO 73
16700 Z=Z+RD/3.
16800 C RETURNS 1/3 OF THE SPACE IF PREV. ITEM IS NOTE OR REST
16900 POS1=POS1-RD/3
17000 C THIS CAN RESULT IN OVERLAP WHICH MUST BE EDITED OUT.!!
17100 73 R(3,K)=POS1
17200 72 POS1=POS1+RD
17300 C ABOVE SECTION LEAVES ROOM FOR CLEF OR BAR
17400 GO TO 337
17500
17600 C 40??? 50???? WHY NOT 100?
17700 71 DO 74 J=KZ,80
17800 74 IF(RE.EQ.-RPOS(2,J))GO TO 75
17900 POS=R(3,K-1)+4
17920 C DON'T BACK OUT OF ARRAY
17950 IF(K.EQ.1)POS=POS1
18000 GO TO 76
18100 75 POS=RPOS(1,J)
18200 KZ=J+1
18300 C FOUND SAME TYPE OF ITEM.
18310 IF(K.EQ.1)GO TO 76
18320 RA=R(3,K-1)
18330 C GET POSITION OF PREVIOUS ITEM
18340 IF(POS.LT.RA)POS=RA+3
18350 C ARBITRARY POSITION FOR CLEF IF IT TRIES TO MATCH ONE SOMEWHERE ELSE.
18400 76 R(3,K)=POS
18500 GO TO 337
18600
18700 2 JX=JX+1
18800 21 CALL DOTS(VAL,RH,JX,DOT)
18900 V(JX)=VAL
19000 IF(RE.NE.2)GO TO 121
19100 V(JX)=-VAL
19200 C SHOWS RESTS IN AUTO. BEAM SECTION.(ASSUMES REST WAS A + NUMB.)
19300 R(7,K)=VAL
19400 GO TO 210
19500 121 IF(R(8,K).GE.-1.)R(9,K)=VAL
19600 C STORES RHYTH VALUE FOR LATER USE IN PART EXTRACTOR IF NOT CHORD NOTE.
19700 CCC IF(AB.GT..05)GO TO 210
19800 IF(RH.NE.88.)GO TO 210
19900 R(3,K)=-1.
20000 R(4,K)=R(4,K)+100.
20100 C WILL THIS BE OK WITH NOTES BELOW B3 (I.E. NEG POSITIONS.
20200 R(7,K)=1
20300 C FOUND A GRACE NOTE (88TH NOTE)
20400 RB=4./88.
20500 R(9,K)=RB
20600 JZ=1
20700 IF(STEM.GE.0)GO TO 1211
20800 IF(R(9,K-1).EQ.RB)GO TO 1211
20900 4211 IF(V(JX+1).EQ.88..AND.R(1,K+1).EQ.1)GO TO 1211
21000 C STEM WILL BE UP UNLESS PRESET OR TWO OR MORE IN A ROW.
21100 IF(R(5,K).GE.20.)R(5,K)=R(5,K)-10.
21200 C NOW STEM IS UP
21300
21400 1211 IF(R(8,K+JZ).GE.0)GO TO 211
21500 J=K+JZ
21600 C GRACE NOTE CHORDS
21700 R(3,J)=-1
21800 C FOR AUTO-SPACING AT 337
21900 R(4,J)=R(4,J)+100.
22000 C MAKE IT A MINI-NOTE
22100 R(8,K)=1000.+ABS(R(4,K)-R(4,J))
22200 C EXTEND THE STEM
22300 JZ=JZ+1
22400 C FOR MORE CHORD NOTES. SHOULD I CHECK FOR END (IZ)?
22500 GO TO 1211
22600 C ** NOT NOW ***TURNS STEM OVER. UNLESS STEM DIRECTIONS WERE FIXED.(SU/SD/)
22700 211 IF(JZ.LE.1)R(8,K)=1000
22800 2211 IF(JSET.GE.0)GO TO 3211
22900 K=K+JZ-1
23000 C POS WILL BE SET AT 336
23100 NTC=NTC+1
23200 C UPDATE THE COUNTER FOR IMPORTANT POSITIONS. POSNT SET AT 336
23300 POSNT(NTC)=-1
23400 GO TO 337
23500 3211 VAL=.1
23600 C IT USED TO JUMP. NOW MAKES SPACE FOR GRACE NOTES AS 32NDS.
23700 210 RB=0
23800 C FOR AUTOMATIC SETUP
23900 JZ=K
24000 C JZ WILL BE USED NEAR END
24100 CC3634 IF(AMOD(AB,.1875).EQ.0)GO TO 122
24200 CC T=IDOT*10
24300 C IDOT IS NUM OF DOTS
24400 IF(RE.EQ.2.)GO TO 35
24500 IF(RH.EQ.88)GO TO 22
24600 CXX T=0
24700 IF(RH.LT.8)GO TO 522
24800 CC IF(R(5,K).LT.10)GO TO 422
24900 C DON'T ADD TAILS TO STEMLESS NOTE. (IT CONFUSES 'BEAMS')
25000 T=IFIX(ALOG(RH)/0.6931472+.001)-2.0
25100 C RH=8=1 TAIL, 16=2TAILS, ETC. THE NUM. (8,16) IS RESULT OF 2 TO THE NTH.
25200 522 RB=0
25300 IF(DOT.EQ.0)GO TO 422
25400 IF(R(6,K).GE.20)RB=100
25500 C TO SHIFT DOT DOWN 2 STEPS
25600 422 R(7,K)=T+RB+DOT
25700 T=0
25800 cc422 R(7,K)=T+IDOT
25900 C PUTS ONE OR MORE DOTS
26000 CC GO TO 36
26100 GO TO 22
26200
26300 35 IF(R(6,K).GE.0)GO TO 135
26400 R(6,K)=-1
26500 GO TO 22
26600 C ADDS DOT TO REST. (IF R6 IS -2. = INVIS. REST. CHANGE IT TO -1)
26700 135 IF(R(8,K).EQ.0)R(6,K)=DOT/10.
26800 C NO DOTS ON 'WHOLE MEASURE' RESTS
26900 CC35 R(6,K)=T/10.
27000 CC36 RB=VAL/3.
27100 CC IF(T.NE.1)RB=(4*VAL)/7
27200 C TO KEEP TAIL ON DOTTED NOTE
27300
27400 22 POS=POS1
27500 IF(R(6,K).GE.30)R(6,K)=R(6,K)-30
27600 C 30 NEEDED FOR SOME CASES WITH DOTS ON CHORDS.
27700 IF(JSET.EQ.0)GO TO 220
27800
27900 C NEXT IS FOR SETUP
28000 222 IF(NOTE)GO TO 223
28100 C FIRST TIME A NOTE IS FOUND.
28200 NOTE=-1
28300 POS1=RLPOS
28400 Z=POS2-POS1
28500 C RESETS SPACE AVAILABLE, ZZ IS SPACE FOR NON-NOTES
28600 223 IF(POS1.LT.AVP2)GO TO 221
28700 224 KX=KX+1
28800 C???? OCT, 73 IF(NX.EQ.0)GO TO 225
28900 L=KX
29000 1228 IF(RPOS(2,L).NE.-3)GO TO 228
29100 L=L+1
29200 C IGNORE CLEFS (BUT NOT BARS) ********* 10/76
29300 GO TO 1228
29400 228 IF(NX)RLP2=RPOS(1,L)
29500 NX=-1
29600 225 IF(RPOS(2,KX-1))GO TO 227
29700 RLPOS=RPOS(1,KX-1)
29800 AVGPOS=AVP2
29900 227 AVP2=RPOS(2,KX)-.001
30000 IF(AVP2.GT.0)GO TO 223
30100 C 0 IN RPOS=POS. OF NON-NOTE
30200 CC****** WHY NEEDED?? 6/74 *** IF(RLP2.GE.POS1)NX=0
30300 NX=0
30400 CC*****↑↑↑↑ CHANGED FROM ABOVE *** 6/74
30500 GO TO 224
30600 221 POS=(POS1-AVGPOS)*(RLP2-RLPOS)/(AVP2-AVGPOS)+RLPOS
30700 220 R(3,K)=POS
30800 4634 IF(RE.NE.1)GO TO 44
30900 IF(POS.EQ.POSNT(NTC))GO TO 2634
31000 C SKIPS OTHER CHORD NOTES.
31100 NTC=NTC+1
31200 POSNT(NTC)=POS
31300 C SAVES IT FOR NUMBS ABOVE NOTES, ETC.
31400 2634 IF(RH.LT.4)GO TO 4
31500 C JUMP IF DENOM. IS LESS THAN 4. I.E. 1/2 NOTE ETC.
31600 44 L=K+1
31700 IF(R(8,L).GE.0)GO TO 1634
31800 IF(R(1,L).NE.1.)GO TO 1634
31900 C JUMP IF NOT DOUBLE STOP
32000 C DELETES STEM FROM WHOLE NOTE CHORD (NOW DONE IN NOTWRT IF P7=1)
32100 R(3,L)=R(3,K)
32200 K=L
32300 CC R(8,K)=0
32400 GO TO 522
32500 C LOOPS BACK TO PICK UP MORE CHORD NOTES
32600
32700 C 'WHITENS' HALF, WHOLE AND TRIPLET HALF NOTES.
32800 4 RA=-R(6,K)
32900 IF(RA.EQ.0)RA=-1
33000 IF(RH.GE.2.)GO TO 144
33100 R(5,K)=AMOD(R(5,K),10.0)
33200 C TAKES STEM INFO OFF ANYTHING LONGER THAN 1/2 NOTES -- FOR SLUR ROUTINE.
33300 RP=1
33400 IF(RH.LE..5)RP=2
33500 R(7,K)=R(7,K)+RP
33600 C +1=WHOLE NOTE WILL PRINT +2=DBL WHL NT.
33700 CC NOT NEEDED BECAUSE OF ABOVE. RA=-2.
33800 144 R(6,K)=RA
33900 GO TO 44
34000
34100 1634 T=POS1
34200 RP=VAL
34300 CFIB IF(STUP.LT.-1)RP=PFIBX(VAL)
34400 IF(STUP.LT.-1)RP=14.0*EXP(ALOG(RP)*0.5849624)
34500 C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5)) NOT FIBBONACI (1.618)
34600 CCC IF(STUP.LT.-1)RP=AB+(.125-AB)*FIB
34700 C FOR PSUEDO-FIB. SPACING
34800 POS1=RP/Y*Z+POS1
34900 535 IF(R(1,JZ).EQ.1.)GO TO 337
35000 RA=R(4,JZ)
35100 C SETS REST
35200 IF(R(8,JZ).NE.0.1)GO TO 537
35300 T=-4
35400 C***** R(8,JZ)=-2
35500 C -2 CENTERS THE SIGN UNDER THE RIGHT CONDITIONS
35600 GO TO 536
35700 CC537 IF(VAL.LT.2)GO TO 538
35800 CC T=-1
35900 CC IF(RH.LT.2)T=-2
36000 CC IF(RH.LT.1)T=-3
36100 C -1=HLF RST, -2=WHOLE, -3=DBL WHL RST, -4=REPEAT BAR SIGN(./.)
36200 CC GO TO 536
36300 537 T=IFIX(ALOG(RH)/0.6931472+.001)-2.
36400 536 R(5,JZ)=T
36500 CCC GO TO 337
36600 C******* 4/74 NEW WAY TO FIND TAILS
36700 C OMITS RESTS (REALLY???)
36800 CCC334 R(7,JZ)=T+R(7,JZ)
36900 337 IF(K.LT.IZ)GO TO 3
37000 CXXXXXXXX M=NTC+1 XXXXXXXXX 9/28/78
37100 C********* WAS M=NTC ******* 4/14/78
37200 M=NTC
37300 DO 335 K=IZ,1,-1
37400 IF(R(3,K).GE.0)GO TO 335
37500 IF(K.NE.IZ)GO TO 336
37600 R(3,K)=POS2-4.
37700 GO TO 335
37800 336 N=K-1
37900 1336 RA=R(3,N)
38000 IF(RA.GT.0)GO TO 2336
38100 N=N-1
38200 IF(N.GT.0)GO TO 1336
38300 C GO BACK (IF MORE GRACE NOTES.) TO FIND PREVIOUS BIG NOTE.
38400 2336 T=R(3,K+1)
38500 RB=T-RA
38600 RA=3
38700 IF(RB.LE.4)RA=RB/2.
38800 C IF SPACE IS SMALL USE 1/3 OF IT.
38900 RB=T-RA
39000 C NEXT FOR GRACE NOTE CHORDS
39100 IF(R(8,K+1).GE.0)GO TO 1335
39200 RB=T
39300 CC RB=R(3,K+1)
39400 CXXXX M=M+1
39500 1335 R(3,K)=RB
39600 POSNT(M)=RB
39700 335 IF(R(8,K).GE.0.AND.R(1,K).EQ.1)M=M-1
39800 C COUNT ONLY NOTES - BUT NOT NON-RHYTH CHORD NOTES.
39900 K=0
40000 45 K=K+1
40100 C NEXT IS TO ARRANGE DOTS.
40200 IF(R(7,K).LT.10)GO TO 451
40300 RA=R(3,K)
40400 DO 452 M=K+1,IZ
40500 IF(R(3,M).NE.RA)GO TO 453
40600 C JUMP IF NOT CHORD NOTE.
40700 T=R(7,M)
40800 RB=R(4,M)
40900 IF(T.LT.100.)GO TO 452
41000 C JUMP IF NOTE IS NOT ON LEFT SIDE OF UPWARD STEM
41100 IF(RB-R(4,M-1).NE.2)GO TO 452
41200 IF(AMOD(RB,2.).NE.0)R(7,M)=AMOD(T,10.)
41300 C TAKES AWAY DOT IN CERTAIN CASES TO AVOID CONFUSION.
41400 452 CONTINUE
41500 453 K=M-1
41600 451 IF(K.LT.IZ)GO TO 45
41700
41800 IF(ICNTPT)GO TO 13
41900 DO 113 K=1,IZ
42000 RA=R(1,K)
42100 IF(RA.GT.2)GO TO 113
42200 C THIS ZEROS RHYTH PARAM IF NOTES WERE ALREADY ON THIS LINE.
42300 J=9
42400 IF(RA.EQ.2)J=7
42500 R(J,K)=0
42600 113 CONTINUE
42700 13 N=IZ
42800 NTC=NTC+1
42900 POSNT(NTC)=200
43000 POSNT(0)=0
43100 IF(IDEV.EQ.5)CALL NOTNUM
43200 END
43300
43400 SUBROUTINE NOTNUM
43500 CC DIMENSION ISU(390)
43600 COMMON R2,JH,CENTR,J2,R3,R4,R5,RJQ(17),J3,J4,J5,JQ(17)
43700 1 /RINP/R(10,85),POSNT(0/99)
43800 1 /RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,PS2
43900 1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
44000 1 /POSI/STFF(0/7),JJ2,POSQ /DPY/ST(4000),MEDIT,GO
44100 CALL DPYSET(3,ST(3600),390)
44200 CALL DPYBRT(6)
44300 J2=STAFF
44400 POSQ=STFF(J2)
44500 J5=1
44600 R4=20
44700 C R5=0=1 STANDARD SIZE IS USED.
44800 R6=0
44900 C NUMBERS ALWAYS DEFAULT SIZE(0=1)
45000 DO 131 K=1,NTC-1
45100 R3=RHORZ(POSNT(K))
45200 CALL PNUM
45300 C GOES TO DRAW A NUMBER OVER A NOTE
45400 J5=J5+1
45500 IF(J5.EQ.10)J5=0
45600 131 CONTINUE
45700 132 CALL DPYOUT(3)
45800 CALL SETPOG(1)
45900 END
46000
46100 SUBROUTINE DOTS(VAL,RH,K,DOT)
46200 COMMON/SCM/V(1)
46300 C FINDS DOTS (1000S), GET RHYTH. AND RHYTHMIC VALUE (QTR=1)
46400 RH=V(K)
46500 IF(RH.EQ.0)RH=88.
46600 VAL=4/RH
46700 J=RH/1000.
46800 DOT=J*10
46900 IF(J.EQ.0)RETURN
47000 RH=RH-J*1000
47100 VAL=4./RH
47200 Z=VAL
47300 1 Z=Z/2
47400 VAL=VAL+Z
47500 J=J-1
47600 IF(J.GT.0)GO TO 1
47700 END